home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / vms / writemain.pl < prev   
Perl Script  |  1994-10-12  |  1KB  |  53 lines
  1. #!./miniperl
  2. #
  3. # Create perlmain.c from miniperlmain.c, adding code to boot the
  4. # extensions listed on the command line.
  5. #
  6.  
  7. if (-f 'miniperlmain.c') { $dir = ''; }
  8. elsif (-f '../miniperlmain.c') { $dir = '../'; }
  9. else { die "$0: Can't find miniperlmain.c\n"; }
  10.  
  11. open (IN,"${dir}miniperlmain.c")
  12.   || die "$0: Can't open ${dir}miniperlmain.c: $!\n";
  13. open (OUT,">${dir}perlmain.c")
  14.   || die "$0: Can't open ${dir}perlmain.c: $!\n";
  15.  
  16. while (<IN>) {
  17.   s/INTERN\.h/EXTERN\.h/;
  18.   print OUT;
  19.   last if /Do not delete this line--writemain depends on it/;
  20. }
  21. $ok = !eof(IN);
  22. close IN;
  23.  
  24. if (!$ok) {
  25.   close OUT;
  26.   unlink "${dir}perlmain.c";
  27.   die "$0: Can't find marker line in ${dir}miniperlmain.c - aborting\n";
  28. }
  29.  
  30.  
  31. if ($#ARGV > -1) {
  32.   print OUT "    char *file = __FILE__;\n";
  33. }
  34.  
  35. foreach $ext (@ARGV) {
  36.   print OUT "extern void    boot_${ext} _((CV* cv));\n"
  37. }
  38.  
  39. foreach $ext (@ARGV) {
  40.   print "Adding $ext . . .\n";
  41.   if ($ext eq 'DynaLoader') {
  42.     # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  43.     # boot_DynaLoader is called directly in DynaLoader.pm
  44.     print OUT "    newXS(\"${ext}::boot_${ext}\", boot_${ext}, file);\n"
  45.   }
  46.   else {
  47.     print OUT "    newXS(\"${ext}::bootstrap\", boot_${ext}, file);\n"
  48.   }
  49. }
  50.  
  51. print OUT "}\n";
  52. close OUT;
  53.